home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / Internet Config 1.2 / Internet Config / Goodies / ICeTEe / ICeTEe.p < prev    next >
Encoding:
Text File  |  1995-09-25  |  9.7 KB  |  397 lines  |  [TEXT/PJMM]

  1. unit ICeTEe;
  2.  
  3. interface
  4.  
  5.     procedure Main;
  6.  
  7. implementation
  8.  
  9.     uses
  10.         Processes, SysEqu, Notification, Traps, 
  11.  
  12.         ShowInit75, 
  13.  
  14.         ICTypes, ICCAPI;
  15.  
  16.     const
  17.         MenuFlash = $A24;
  18.         ToolScratch = $9CE;
  19.  
  20.     const
  21.         kCreator = 'ICTE';
  22.  
  23.     const
  24.         (* EXCL *)
  25.         rExclusions = 128;
  26.  
  27.         (* ICN# *)
  28.         rICTEIcon = 128;
  29.         rFailedIcon = 129;
  30.  
  31.         (* STR# *)
  32.         rErrorStrings = 128;
  33.         strMiscErr = 1;
  34.         strNoCMErr = 2;
  35.         strNoICErr = 3;
  36.         strInsufficientICErr = 4;
  37.         strNoMemoryErr = 5;
  38.         strCantFindHelperErr = 6;
  39.         strNoHelperErr = 7;
  40.         strNoURLErr = 8;
  41.         strCantHackIt = 9;
  42.  
  43.     const
  44.         noCMErr = -6660;
  45.  
  46.     type
  47.         exArray = array[1..1000] of OSType;
  48.         exPtr = ^exArray;
  49.         exHandle = ^exPtr;
  50.  
  51.         icteGlobals = record
  52.                 signature: OSType;
  53.                 version: NumVersion;
  54.                 exclusions: exHandle;
  55.                 errors: Handle;
  56.                 old_teclick: ProcPtr;
  57.             end;
  58.         icteGlobalsPtr = ^icteGlobals;
  59.         icteGlobalsPtrPtr = ^icteGlobalsPtr;
  60.  
  61.     function GetIndStrH (h: handle; index: integer): str255;
  62.     (* Stolen directly from PNL's MyStrH unit *)
  63.         var
  64.             count, i: integer;
  65.             s: str255;
  66.             ps: longInt;
  67.     begin
  68.         count := integerPtr(h^)^;
  69.         if (1 <= index) and (index <= count) then begin
  70.             ps := SizeOf(integer);
  71.             for i := 1 to index - 1 do
  72.                 ps := ps + BAND(ptr(ord(h^) + ps)^, $FF) + 1;
  73.             BlockMove(ptr(ord(h^) + ps), @s, BAND(ptr(ord(h^) + ps)^, $FF) + 1);
  74.         end
  75.         else begin
  76.             s := '';
  77.         end;
  78.         GetIndStrH := s;
  79.     end;
  80.  
  81.     function DecStr (l: longint): Str32;
  82.         var
  83.             tmp: Str255;
  84.     begin
  85.         NumToString(l, tmp);
  86.         DecStr := tmp;
  87.     end; (* DecStr *)
  88.  
  89.     function GetMyGlobals: icteGlobalsPtr;
  90.     begin
  91.         GetMyGlobals := icteGlobalsPtrPtr(@Main)^;
  92.     end; (* GetMyGlobals *)
  93.  
  94.     procedure SetMyGlobals (globals: icteGlobalsPtr);
  95.         var
  96.             tmp: icteGlobalsPtrPtr;
  97.     begin
  98.         tmp := icteGlobalsPtrPtr(@Main);
  99.         tmp^ := globals;
  100.     end; (* SetMyGlobals *)
  101.  
  102.     function CurrentProcessExcluded: boolean;
  103.         var
  104.             PSN: ProcessSerialNumber;
  105.             info: ProcessInfoRec;
  106.             exclusions: exHandle;
  107.             i: integer;
  108.     begin
  109.         PSN.highLongOfPSN := 0;
  110.         PSN.lowLongOfPSN := kCurrentProcess;
  111.         info.processInfoLength := sizeof(ProcessInfoRec);
  112.         info.processName := nil;
  113.         info.processAppSpec := nil;
  114.         if GetProcessInformation(PSN, info) = noErr then begin
  115.             exclusions := GetMyGlobals^.exclusions;
  116.             CurrentProcessExcluded := false;
  117.             for i := 1 to GetHandleSize(Handle(exclusions)) div 4 do begin
  118.                 if exclusions^^[i] = info.processSignature then begin
  119.                     CurrentProcessExcluded := true;
  120.                     leave;
  121.                 end; (* if *)
  122.             end; (* for *)
  123.         end
  124.         else begin
  125.             CurrentProcessExcluded := true;
  126.         end; (* if *)
  127.     end; (* CurrentProcessExcluded *)
  128.  
  129.     function HaveComponentManager: boolean;
  130.         var
  131.             response: longint;
  132.     begin
  133.         HaveComponentManager := (Gestalt(gestaltComponentMgr, response) = noErr);
  134.     end; (* HaveComponentManager *)
  135.  
  136.     function DoCommandClick (teh: TEHandle; selStart, selEnd: longint): ICError;
  137.         var
  138.             inst: ComponentInstance;
  139.             err: ICError;
  140.             err2: ICError;
  141.             text: Handle;
  142.             s: signedByte;
  143.             rgn: RgnHandle;
  144.             i: integer;
  145.             junklong: longint;
  146.             hint, at: Str31;
  147.             urlh: Handle;
  148.     begin
  149.         if HaveComponentManager then begin
  150.             err := ICCStart(inst, kCreator);
  151.         end
  152.         else begin
  153.             err := noCMErr;
  154.         end; (* if *)
  155.         if err = noErr then begin
  156.             err := ICCFindConfigFile(inst, 0, nil);
  157.             if err = noErr then begin
  158.                 text := Handle(TEGetText(teh));
  159.                 s := HGetState(text);
  160.                 HLock(text);
  161.                 urlh := NewHandle(0);
  162.                 hint := 'mailto';
  163.                 err := ICCParseURL(inst, hint, text^, GetHandleSize(text), selStart, selEnd, urlh);
  164.                 if err = noErr then begin
  165.                     hint := '';
  166.                     at := '@';
  167.                     if Munger(urlh, 0, @at[1], length(at), nil, 0) >= 0 then begin
  168.                         hint := 'mailto';
  169.                     end;
  170.                     err := ICCLaunchURL(inst, hint, text^, GetHandleSize(text), selStart, selEnd);
  171.                 end;
  172.                 DisposeHandle(urlh);
  173.                 TESetSelect(selStart, selEnd, teh);
  174.                 if err = noErr then begin
  175.                     for i := 1 to integerPtr(MenuFlash)^ do begin
  176.                         Delay(5, junklong);
  177.                         TEDeactivate(teh);
  178.                         Delay(5, junklong);
  179.                         TEActivate(teh);
  180.                     end; (* for *)
  181.                 (* leave the URL selected *)
  182.                 end; (* if *)
  183.                 HSetState(text, s);
  184.             end; (* if *)
  185.             err2 := ICCStop(inst);
  186.             if err = noErr then begin
  187.                 err := err2;
  188.             end; (* if *)
  189.         end; (* if *)
  190.         DoCommandClick := err;
  191.     end; (* DoCommandClick *)
  192.  
  193.     procedure MyNMResponseProc (nm: NMRecPtr);
  194.         var
  195.             ozone: THz;
  196.             strh: Handle;
  197.             junk: OSErr;
  198.     begin
  199.         junk := NMRemove(nm);
  200.         ozone := GetZone;
  201.         SetZone(SystemZone);
  202.         strh := RecoverHandle(Ptr(nm^.nmStr));
  203.         if strh <> nil then begin
  204.             DisposeHandle(strh);
  205.         end; (* if *)
  206.         DisposePtr(Ptr(nm));
  207.         SetZone(ozone);
  208.     end; (* MyNMResponseProc *)
  209.  
  210.     procedure MyTEClick (teh: TEHandle; old_selStart, old_selEnd: integer);
  211.         var
  212.             err: ICError;
  213.             message: Str255;
  214.             nm: NMRecPtr;
  215.             strindex: integer;
  216.             strh: StringHandle;
  217.     begin
  218.         if not CurrentProcessExcluded then begin
  219.             if not ((old_selStart <= teh^^.selStart) and (teh^^.selStart <= old_selEnd) and (old_selStart <= teh^^.selEnd) and (teh^^.selEnd <= old_selEnd)) then begin
  220.                 old_selStart := teh^^.selStart;
  221.                 old_selEnd := teh^^.selEnd;
  222.             end; (* if *)
  223.             err := DoCommandClick(teh, old_selStart, old_selEnd);
  224.             if err <> noErr then begin
  225.                 (* can't case on the error codes because MPW Pascal does not case on longints properly *)
  226.                 if err = badComponentInstance then begin
  227.                     strindex := strNoICErr;
  228.                 end
  229.                 else if err = noCMErr then begin
  230.                     strindex := strNoCMErr;
  231.                 end
  232.                 else if err = badComponentSelector then begin
  233.                     strindex := strInsufficientICErr;
  234.                 end
  235.                 else if err = memFullErr then begin
  236.                     strindex := strNoMemoryErr;
  237.                 end
  238.                 else if err = afpItemNotFound then begin
  239.                     strindex := strCantFindHelperErr;
  240.                 end
  241.                 else if err = icPrefNotFoundErr then begin
  242.                     strindex := strNoHelperErr;
  243.                 end
  244.                 else if err = icNoURLErr then begin
  245.                     strindex := strNoURLErr;
  246.                 end
  247.                 else if err = noPortErr then begin
  248.                     strindex := strCantHackIt;
  249.                 end
  250.                 else begin
  251.                     strindex := strMiscErr;
  252.                 end; (* if *)
  253.                 message := GetIndStrH(GetMyGlobals^.errors, strindex);
  254.                 if message <> '' then begin
  255.                     strindex := Pos('^0', message);
  256.                     if strindex <> 0 then begin
  257.                         Delete(message, strindex, 2);
  258.                         Insert(DecStr(err), message, strindex);
  259.                     end; (* if *)
  260.                     strh := NewString(message);
  261.                     HLock(Handle(strh));
  262.                     nm := NMRecPtr(NewPtrSysClear(sizeof(NMRec)));
  263.                     if nm <> nil then begin
  264.                         nm^.qType := ord(nmType);
  265.                         nm^.nmMark := 0;
  266.                         nm^.nmIcon := nil;
  267.                         nm^.nmSound := nil;
  268.                         nm^.nmStr := strh^;
  269.                         nm^.nmResp := @MyNMResponseProc;
  270.                         err := NMInstall(nm);
  271.                     end
  272.                     else begin
  273.                         SysBeep(10);
  274.                     end; (* if *)
  275.                 end; (* if *)
  276.             end; (* if *)
  277.         end; (* if *)
  278.     end; (* MyTEClick *)
  279.  
  280.     procedure CallTEClick (pt: Point; fExtend: boolean; teh: TEHandle; proc: ProcPtr);
  281.     inline
  282.         $205F, (* move.l    (a7)+,a0            ; pop proc address    *)
  283.         $4E90; (* jsr            (a0)                ; call proc                *)
  284.  
  285.     procedure InlinePushAll;
  286.     inline
  287.         $48E7, $FFFC;
  288.  
  289.     procedure InlinePopAll;
  290.     inline
  291.         $4CDF, $3FFF;
  292.  
  293.     procedure PascalTEClickPatch (pt: Point; fExtend: boolean; teh: TEHandle);
  294.         var
  295.             old_selStart, old_selEnd: integer;
  296.             globals: icteGlobalsPtr;
  297.             ozone: THz;
  298.             command_key: boolean;
  299.             km: KeyMap;
  300.     begin
  301.         InlinePushAll;
  302.         globals := GetMyGlobals;
  303.         old_selStart := teh^^.selStart;
  304.         old_selEnd := teh^^.selEnd;
  305.         GetKeys(km);
  306.         command_key := km[55];
  307.         CallTEClick(pt, fExtend, teh, globals^.old_teclick);
  308.         if command_key then begin
  309.             ozone := GetZone;
  310.             SetZone(SystemZone);
  311.             MyTEClick(teh, old_selStart, old_selEnd);
  312.             SetZone(ozone);
  313.         end; (* if *)
  314.         InlinePopAll;
  315.     end; (* PascalTEClickPatch *)
  316.  
  317.     function MyGestalt (selector: OSType; var response: longint): OSErr;
  318.         var
  319.             globals: icteGlobalsPtr;
  320.     begin
  321.         globals := GetMyGlobals;
  322.         response := longint(globals);
  323.         MyGestalt := noErr;
  324.     end; (* MyGestalt *)
  325.  
  326.     procedure Main;
  327.         var
  328.             ozone: THz;
  329.             err: OSErr;
  330.             err2: OSErr;
  331.             response: longint;
  332.             globals: icteGlobalsPtr;
  333.             exclusions: Handle;
  334.             errors: Handle;
  335.             vers: VersRecHndl;
  336.     begin
  337. (* Debugger; *)
  338.         (* detach our resource *)
  339.         DetachResource(RecoverHandle(Ptr(longintPtr(ToolScratch)^)));
  340.         ShowIcon7(rICTEIcon, false);
  341.         ozone := GetZone;
  342.         SetZone(SystemZone);
  343.         (* check for System 7 *)
  344.         err := noErr;
  345.         if (Gestalt(gestaltSystemVersion, response) <> noErr) | (response < $700) then begin
  346.             err := unimpErr;
  347.         end; (* if *)
  348.         (* create the globals *)
  349.         if err = noErr then begin
  350.             globals := icteGlobalsPtr(NewPtrSysClear(sizeof(icteGlobals)));
  351.             err := MemError;
  352.         end; (* if *)
  353.         if err = noErr then begin
  354.             (* install globals *)
  355.             SetMyGlobals(globals);
  356.             globals := GetMyGlobals;
  357.             (* init globals *)
  358.             globals^.signature := kCreator;
  359.             vers := VersRecHndl(Get1Resource('vers', 1));
  360.             if vers <> nil then begin
  361.                 globals^.version := vers^^.numericVersion;
  362.             end; (* if *)
  363.             exclusions := Get1Resource('EXCL', rExclusions);
  364.             err := HandToHand(exclusions);
  365.             globals^.exclusions := exHandle(exclusions);
  366.             errors := Get1Resource('STR#', rErrorStrings);
  367.             err2 := HandToHand(errors);
  368.             globals^.errors := errors;
  369.             if err = noErr then begin
  370.                 err := err2;
  371.             end; (* if *)
  372.         end; (* if *)
  373.         (* register gestalt *)
  374.         if err = noErr then begin
  375.             err := NewGestalt(kCreator, @MyGestalt);
  376.         end; (* if *)
  377.         if err = noErr then begin
  378.         (* install our patch *)
  379.             globals^.old_teclick := ProcPtr(NGetTrapAddress(_TEClick, ToolTrap));
  380.             NSetTrapAddress(longint(@PascalTEClickPatch), _TEClick, ToolTrap);
  381.         end; (* if *)
  382.         (* if we got an error then we bleed memory all over the place, this is not an accident *)
  383.         (* how many copies of the init can you reasonably fail to install??? *)
  384.         SetZone(ozone);
  385.  
  386.         if err = noErr then begin
  387.             ShowIcon7(rICTEIcon, true);
  388.         end
  389.         else begin
  390.             ShowIcon7(rFailedIcon, true);
  391.         end; (* if *)
  392.     end; (* Main *)
  393.  
  394. end. (* ICeTEe *)
  395. selStartX, selEndX: longint;
  396. selStartX := selStart;
  397. selEndX := selEnd;